home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / visualsort / source / visualsort.e next >
Text File  |  1993-09-29  |  42KB  |  997 lines
  1. /**********************************************************
  2.  *                                                        *
  3.  *       --- VisualSort v1.15 by Nico Max ---             *
  4.  *                                                        *
  5.  * Das Teil ist PD, somit darf es jeder kopieren, wie     *
  6.  * sie/er Lust dazu hat. Wer im Source herumwurschteln    *
  7.  * mag, kann dies meinetwegen gern tun (und dabei irgend- *
  8.  * welche Fehler findet, oder Verbesserungen - mir bitte  *
  9.  * mitteilen!)                                            *
  10.  *                                                        *
  11.  **********************************************************/
  12.  
  13. MODULE 'intuition/screens','intuition/intuition','intuition/gadgetclass',
  14.        'graphics/displayinfo','graphics/modeid','graphics/text','graphics/rastport',
  15.        'gadtools','libraries/gadtools',
  16.        'reqtools','libraries/reqtools',
  17.        'exec/nodes','exec/ports','exec/memory',
  18.        'rexxsyslib','rexx/errors','rexx/storage',
  19.        'devices/inputevent','keymap','dos/dos',
  20.        'libraries/locale','locale'
  21.  
  22. OPT OSVERSION=37
  23.  
  24. CONST COLSET=2,COLCLEAR=0,DRAWMX=$f882,DIRECTIONMX=$f8e2,IMMMX=$f9c2
  25.  
  26. OBJECT rexxobj
  27.   keyword,len:CHAR
  28. ENDOBJECT
  29. OBJECT statisticrec
  30.   moves,comps,elems
  31. ENDOBJECT
  32.  
  33.  
  34. ENUM SCHLEIF
  35. ENUM ARG_AS,ARG_DES,ARG_DEGREE,ARG_LINES,NUMARGS
  36. ENUM ABOUT,QUIT,BUBBLE,SHAKE,INSERT,SEL,SHELL,MERGE,QUICK,HEAP,SCREEN,BREAK,STOPS,
  37.      POINTS,LINES,RANDOMIZE,ASCENDING,DESCENDING,DEGREE,STATISTICS,IMMEDIATE,
  38.      SAVESTATISTICS,FREEHAND,COMPLETE,FREEINITVALUE,POPUP,POPBACK
  39. ENUM PROG_L,SAVE_L,ABOUT_L,QUIT_L,ALG_L,BUBBLE_L,SHAKE_L,INSERT_L,SELECT_L,
  40.      SHELL_L,MERGE_L,QUICK_L,HEAP_L,STATISTIK_L,SETUP_L,SCR_L,DEGREE_L,
  41.      FREEINIT_L,POINTS_L,LINES_L,RAND_L,ASC_L,DES_L,FREEHAND_L,COMPLETE_L,
  42.      IMM_L,WELCOME_L,ARRAYCREATE_L,ARRAYCOMPLETE_L,BREAK_L,STOP_L,BUBBLEW_L,
  43.      SHAKEW_L,JOKE_L,DRAW_L,WHICHVALUE_L,BREAKBUTTON_L,STOPBUTTON_L,
  44.      SAVEREQTITLE_L,SCRMODE_L,DEGREETITLE_L,FREEINITVALUE_L,SCREENTITLE_L,
  45.      ABOUTREQ1_L,ABOUTREQ2_L,ABOUTBUTTONS_L,OKBUTTON_L,ALGSTATISTIK_L,
  46.      ERRCOULDNT_L,
  47.      ERRPUBSCR_L,ERROPENSCR_L,ERROPENWIN_L,ERRMODEID_L,ERRVISUAL_L,
  48.      ERRCONTXT_L,ERRGADGET_L,ERRMENUS_L,ERROPEN_L,ERRWRITE_L,BOTHASCDES_L,
  49.      ERRDEGREE_L,CHOOSEASCDES_L,WHICHDEGREE_L,LOWMEM_L,REXXDEGREE_L,
  50.      REXXNUMERICNEED_L,REXXNEEDKEYWORD_L,REXXFILENAMENEED_L,
  51.      REXXWRONGFREEHAND_L,REXXONOFFONLY_L,REXXUNKNOWNCOMMAND_L,
  52.      SETFREETOZERO_L,NEEDGADTOOLS_L,NEEDREQTOOLS_L,ERRSCRMODESTRUCT_L,
  53.      ERRFILEREQSTRUCT_L,KEYMAP_L,SECONDCOPY_L,ERRMSGPORT_L,CLOSESCR
  54.  
  55. RAISE ERRPUBSCR_L  IF LockPubScreen()=0,
  56.       ERRMODEID_L  IF GetVPModeID()=INVALID_ID,
  57.       ERROPENSCR_L IF OpenScreenTagList()=0,
  58.       ERROPENWIN_L IF OpenWindowTagList()=0,
  59.       ERRVISUAL_L  IF GetVisualInfoA()=0,
  60.       ERRCONTXT_L  IF CreateContext()=0,
  61.       ERRGADGET_L  IF CreateGadgetA()=0,
  62.       ERRMENUS_L   IF CreateMenusA()=0,
  63.       ERRMENUS_L   IF LayoutMenusA()=0,
  64.       ERROPEN_L    IF Open()=0,
  65.       ERRWRITE_L   IF VfPrintf()= TRUE
  66.  
  67. DEF scr=0:PTR TO screen,pscr:PTR TO screen,win=0:PTR TO window,
  68.     visual=0,menus, glist=0:PTR TO gadget,msgmenucode=MENUNULL,
  69.     rexxport=0:PTR TO mp,lptr:PTR TO ln,
  70.     catalog=0:PTR TO catalog,builtinlanguage:PTR TO LONG,
  71.     rexxkeywords:PTR TO rexxobj,rexxmsg:PTR TO rexxmsg,rexxwait= FALSE,
  72.     scroller:PTR TO gadget, bstop:PTR TO gadget,bexit:PTR TO gadget,
  73.     infoy,infox,inforecty,
  74.     screenmodereq=0:PTR TO rtscreenmoderequester,filereq=0:PTR TO rtfilerequester,
  75.     adr=0:PTR TO INT,maxlen,
  76.     rectop,recleft,recheight, font=0,textheight,
  77.     args[NUMARGS]:LIST,
  78.     lines=0,ascending= TRUE,random= TRUE, degree=75,immediate= TRUE,
  79.     statistics[7]:ARRAY OF statisticrec,break,freehand=0,
  80.     complete= TRUE,funcs:PTR TO LONG,freeinitvalue=0
  81.  
  82. PROC main() HANDLE
  83. DEF x:PTR TO LONG,templ,rdargs
  84.   initdatas(); openlibs()
  85.   FOR x:=0 TO NUMARGS-1 DO args[x]:=0
  86.   templ:='A=ASCENDING/S,D=DESCENDING/S,DEGREE/N,LINES/S'; rdargs:=ReadArgs(templ,args,NIL)
  87.   IF (args[ARG_AS]<>0) AND (args[ARG_DES]<>0)
  88.     WriteF(getstr(BOTHASCDES_L)); Raise(SCHLEIF); ENDIF
  89.   IF ((x:=Long(args[ARG_DEGREE]))<0) OR (x>100)
  90.     WriteF(getstr(ERRDEGREE_L)); Raise(SCHLEIF); ENDIF
  91.   IF ((args[ARG_AS]=0) AND (args[ARG_DES]=0)) AND args[ARG_DEGREE]
  92.     WriteF(getstr(CHOOSEASCDES_L)); Raise(SCHLEIF); ENDIF
  93.   IF ((args[ARG_AS] OR args[ARG_DES]) AND (args[ARG_DEGREE]=0))
  94.     WriteF(getstr(WHICHDEGREE_L)); Raise(SCHLEIF); ENDIF
  95.   IF args[ARG_LINES] THEN lines:= 1
  96.   IF args[ARG_DEGREE]
  97.     degree:= Long(args[ARG_DEGREE]); random:= FALSE
  98.     IF args[ARG_DES] THEN ascending:= FALSE
  99.   ENDIF
  100.   opengui(0,getstr(WELCOME_L))
  101.   wait4message(); closegui(); closelibs(); IF rdargs THEN FreeArgs(rdargs)
  102. EXCEPT
  103.   IF exception <> SCHLEIF THEN printerrmsg(getstr(ERRCOULDNT_L),[getstr(exception)])
  104.   closegui(); closelibs(); IF rdargs THEN FreeArgs(rdargs)
  105. ENDPROC
  106.  
  107. PROC wait4message()
  108. DEF what,reqtags,filename[111]:ARRAY
  109.   LOOP
  110.     what:= checkports()
  111.     SELECT what
  112.       CASE SAVESTATISTICS;
  113.         IF filereq
  114.           IF RtFileRequestA(filereq,filename,getstr(SAVEREQTITLE_L),
  115.             [RT_WINDOW,win,RT_LOCKWINDOW,TRUE,RT_REQPOS,REQPOS_CENTERWIN,
  116.              RT_UNDERSCORE,"_",RTFI_FLAGS,FREQF_SAVE,0])
  117.             save_statistics(filereq.dir,filename)
  118.           ENDIF
  119.         ENDIF
  120.       CASE ABOUT
  121.         IF reqtoolsbase
  122.            reqtags:= [RT_WINDOW,win,RT_LOCKWINDOW,TRUE,RT_REQPOS,REQPOS_CENTERWIN,
  123.                       RT_UNDERSCORE,"_",RTEZ_FLAGS,EZREQF_CENTERTEXT,0]
  124.           IF RtEZRequestA(getstr(ABOUTREQ1_L),getstr(ABOUTBUTTONS_L),0,0,reqtags)
  125.              RtEZRequestA(getstr(ABOUTREQ2_L),getstr(OKBUTTON_L),0,
  126.                           [AvailMem(MEMF_CHIP),AvailMem(MEMF_FAST)],reqtags)
  127.           ENDIF
  128.         ENDIF
  129.       CASE QUIT; RETURN
  130.       CASE SCREEN
  131.         IF screenmodereq
  132.           IF RtScreenModeRequestA(screenmodereq,getstr(SCRMODE_L),
  133.               [RT_WINDOW,win,RT_LOCKWINDOW,TRUE,
  134.                RT_REQPOS,REQPOS_CENTERWIN,0])
  135.              closegui(); opengui(screenmodereq.displayid,getstr(JOKE_L))
  136.           ENDIF; ENDIF
  137.       CASE POPUP;   ScreenToFront(scr); ActivateWindow(win)
  138.       CASE POPBACK; ScreenToBack(scr)
  139.       CASE DEGREE
  140.         IF reqtoolsbase
  141.           RtGetLongA({degree},getstr(DEGREETITLE_L),0,
  142.           [RT_WINDOW,win,RT_REQPOS,REQPOS_CENTERWIN,RT_LOCKWINDOW,TRUE,
  143.            RTGL_MIN,0,RTGL_MAX,100,
  144.            RTGL_SHOWDEFAULT,TRUE,0]); ENDIF
  145.       CASE FREEINITVALUE
  146.         IF reqtoolsbase
  147.           RtGetLongA({freeinitvalue},getstr(FREEINITVALUE_L),0,
  148.           [RT_WINDOW,win,RT_REQPOS,REQPOS_CENTERWIN,RT_LOCKWINDOW,TRUE,
  149.            RTGL_MIN,0,RTGL_MAX,recheight,
  150.            RTGL_SHOWDEFAULT,TRUE,0]); ENDIF
  151.       CASE POINTS;     lines:= 0; checkmxmenus(DRAWMX,2,1)
  152.       CASE LINES;      lines:= 1; checkmxmenus(DRAWMX,2,2)
  153.       CASE RANDOMIZE;  random:=    TRUE;  freehand:= FALSE; checkmxmenus(DIRECTIONMX,4,1)
  154.       CASE ASCENDING;  ascending:= TRUE;  freehand:= random:= FALSE; checkmxmenus(DIRECTIONMX,4,2)
  155.       CASE DESCENDING; ascending:= FALSE; freehand:= random:= FALSE; checkmxmenus(DIRECTIONMX,4,3)
  156.       CASE FREEHAND;   freehand:=  TRUE;  checkmxmenus(DIRECTIONMX,4,4)
  157.       CASE STATISTICS; show_statistics()
  158.       DEFAULT
  159.         IF (what >= BUBBLE) AND (what <= HEAP)
  160.           createarray()
  161.           IF adr; start_algorithmus(what)
  162.           ELSE
  163.             printerrmsg(getstr(LOWMEM_L),0)
  164.           ENDIF
  165.         ENDIF
  166.     ENDSELECT
  167.   ENDLOOP
  168. ENDPROC
  169.  
  170. PROC checkports()
  171. DEF mes:PTR TO intuimessage,what,port:PTR TO mp,class,code,alg,
  172.     nochmal=TRUE,arg[100]:STRING,restarg,x,len,rmb,mx,my,x2=-1,
  173.     item:PTR TO menuitem
  174.   IF rexxwait; ReplyMsg(rexxmsg); rexxwait:= FALSE; ENDIF
  175.   LOOP
  176.     REPEAT
  177.       IF msgmenucode<>MENUNULL
  178.         item:= ItemAddress(menus,msgmenucode)
  179.         IF (what:= getwhat(0,IDCMP_MENUPICK,item.nextselect,0))<>-1 THEN RETURN what
  180.       ENDIF
  181.       IF mes:= GetMsg(port:= win.userport)
  182.         nochmal:= TRUE
  183.         IF mes:= Gt_FilterIMsg(mes)
  184.           what:= getwhat(mes.iaddress,mes.class,mes.code,mes.qualifier)
  185.         ELSE; what:= -1; ENDIF
  186.         Gt_ReplyIMsg(mes)
  187.         IF what<>-1
  188.           IF (what>=BUBBLE) AND (what<=HEAP) AND freehand
  189.             alg:= what; what:= -1
  190.             SetAPen(win.rport,0); RectFill(win.rport,recleft-2,rectop-1,maxlen+3,recheight+rectop+1)
  191.             win.flags:= win.flags OR WFLG_RMBTRAP
  192.             IF adr THEN Dispose(adr)
  193.             adr:= New(Shl(maxlen+1,1))
  194.             IF adr
  195.               FOR x:= 0 TO maxlen; adr[x]:= freeinitvalue; setpoint(x,freeinitvalue,1); ENDFOR
  196.               clearinfo(); SetAPen(win.rport,1)
  197.               TextF(infox,infoy,getstr(DRAW_L))
  198.               rmb:= mx:= my:= 0; x:= 1;
  199.               REPEAT
  200.                 IF mes:= GetMsg(port)
  201.                   class:= mes.class; code:= mes.code; ReplyMsg(mes)
  202.                   IF class=IDCMP_MOUSEBUTTONS
  203.                     SELECT code
  204.                         CASE IECODE_RBUTTON+IECODE_UP_PREFIX; rmb:= TRUE
  205.                         CASE IECODE_LBUTTON
  206.                           clearinfo()
  207.                           WHILE Mouse()=1
  208.                             IF (mx:= MouseX(win))<recleft; mx:= recleft
  209.                             ELSE
  210.                               IF mx>(recleft+maxlen) THEN mx:= recleft+maxlen
  211.                             ENDIF
  212.                             IF (my:= MouseY(win))<rectop; my:= rectop
  213.                             ELSE
  214.                               IF my>(rectop+recheight) THEN my:= rectop+recheight
  215.                             ENDIF
  216.                             mx:= mx-recleft
  217.                             IF lines
  218.                               IF (my >= rectop) AND (my <= (Shr(recheight,1)+rectop))
  219.                                 my:= Shl(Shr(recheight,1)+rectop-my,1)
  220.                               ELSE; my:= Shl(my-Shr(recheight,1)-rectop,1)
  221.                               ENDIF
  222.                             ELSE; my:= rectop+recheight-my; ENDIF
  223.                             IF (mx<>x2) AND (adr[mx]=freeinitvalue)
  224.                               x2:= mx; displayinfo(getstr(WHICHVALUE_L),[x++])
  225.                             ENDIF
  226.                             IF adr[mx]<>my
  227.                               setpoint(mx,adr[mx],0); adr[mx]:= my
  228.                               setpoint(mx,adr[mx],1); ENDIF
  229.                           ENDWHILE
  230.                     ENDSELECT
  231.                   ENDIF
  232.                 ELSE; Wait(Shl(1,port.sigbit)); ENDIF
  233.               UNTIL rmb
  234.               win.flags:= win.flags AND Not(WFLG_RMBTRAP)
  235.               IF complete THEN complete_array()
  236.               start_algorithmus(alg)
  237.             ELSE; printerrmsg(getstr(LOWMEM_L),0); ENDIF
  238.           ENDIF; IF what <> -1 THEN RETURN what
  239.         ENDIF
  240.       ELSE; nochmal:= FALSE; ENDIF
  241.       IF rexxmsg:= GetMsg(rexxport)
  242.         nochmal:= TRUE
  243.         StrCopy(arg,TrimStr(Long(rexxmsg.args)),100); UpperStr(arg)
  244.         rexxmsg.result1:= RC_WARN; rexxmsg.result2:= 0
  245.         what:=0 ; nochmal:= TRUE
  246.         REPEAT
  247.         UNTIL StrCmp(x:=rexxkeywords[what].keyword,arg,
  248.                      len:= rexxkeywords[what++].len) OR (len=0)
  249.         IF len
  250.           IF Char(restarg:= TrimStr(arg+len))=0 THEN rexxmsg.result1:= RC_OK
  251.           IF what--=DEGREE
  252.             degree:= Val(restarg,{x}); what:= -1
  253.             IF x
  254.               IF (degree < 0) OR (degree > 100)
  255.                 printerrmsg(getstr(REXXDEGREE_L),0)
  256.                 degree:= -1
  257.               ELSE
  258.                 rexxmsg.result1:= RC_OK; random:= FALSE
  259.                 checkmxmenus(DIRECTIONMX,3,IF ascending THEN 2 ELSE 3)
  260.               ENDIF
  261.             ELSE
  262.               printerrmsg(getstr(REXXNUMERICNEED_L),rexxmsg.args)
  263.               degree:= -1; ENDIF
  264.           ELSE
  265.             IF (what >= BUBBLE) AND (what <= HEAP)
  266.               IF restarg[]
  267.                 IF StrCmp(restarg,'WAIT',ALL)
  268.                   rexxwait:= TRUE; rexxmsg.result1:= RC_OK; ENDIF
  269.               ELSE; rexxmsg.result1:= RC_OK; ENDIF
  270.             ELSE
  271.               IF ((x:=what)=IMMEDIATE) OR (what=COMPLETE)
  272.                 what:= -1
  273.                 IF restarg[]
  274.                   rexxmsg.result1:= RC_OK
  275.                   IF StrCmp(restarg,'ON',ALL)
  276.                     IF x=IMMEDIATE THEN immediate:= TRUE ELSE complete:= TRUE
  277.                     checkmxmenus(IF x=IMMEDIATE THEN IMMMX ELSE IMMMX-$40,1,1)
  278.                   ELSE
  279.                     IF StrCmp(restarg,'OFF',ALL)
  280.                       IF x=IMMEDIATE THEN immediate:= FALSE ELSE complete:= FALSE
  281.                       checkmxmenus(IF x=IMMEDIATE THEN IMMMX ELSE IMMMX-$40,1,0)
  282.                     ELSE
  283.                       printerrmsg(getstr(REXXONOFFONLY_L),rexxmsg.args)
  284.                       rexxmsg.result1:= RC_WARN; ENDIF; ENDIF
  285.                 ELSE; printerrmsg(getstr(REXXNEEDKEYWORD_L),rexxmsg.args); ENDIF
  286.               ELSE
  287.                 IF what=SAVESTATISTICS
  288.                   what:= -1
  289.                   IF restarg[]
  290.                     save_statistics('',TrimStr(Long(rexxmsg.args)+len))
  291.                     rexxmsg.result1:= RC_OK
  292.                   ELSE; printerrmsg(getstr(REXXFILENAMENEED_L),rexxmsg.args); ENDIF
  293.                 ELSE
  294.                   IF what=FREEINITVALUE
  295.                     freeinitvalue:= Val(restarg,{x}); what:= -1
  296.                     IF x
  297.                       IF (freeinitvalue < 0) OR (freeinitvalue > recheight)
  298.                         printerrmsg(getstr(REXXWRONGFREEHAND_L),{recheight})
  299.                         freeinitvalue:= 0
  300.                       ELSE; rexxmsg.result1:= RC_OK; ENDIF
  301.                     ELSE
  302.                       printerrmsg(getstr(REXXNUMERICNEED_L),rexxmsg.args)
  303.                       freeinitvalue:= 0; ENDIF
  304.                   ENDIF
  305.                 ENDIF
  306.               ENDIF
  307.             ENDIF
  308.           ENDIF              /* ok, ich geb's zu; nächstes Mal nehme ich */
  309.                              /* ReadArgs()                               */
  310.           IF (what<>-1) AND restarg[]
  311.             printerrmsg(getstr(REXXUNKNOWNCOMMAND_L),rexxmsg.args); what:= -1; ENDIF
  312.         ELSE; printerrmsg(getstr(REXXUNKNOWNCOMMAND_L),rexxmsg.args); what:= -1; ENDIF
  313.         IF (rexxmsg.action AND RXFF_RESULT) AND (what<>-1)
  314.           rexxsysbase:= rexxmsg.libbase
  315.           rexxmsg.result2:= CreateArgstring(arg,StrLen(arg))
  316.         ENDIF
  317.         IF rexxwait= FALSE THEN ReplyMsg(rexxmsg)
  318.         IF what   <> -1    THEN RETURN what
  319.       ENDIF
  320.     UNTIL nochmal=FALSE
  321.     Wait(Shl(1,port.sigbit) OR Shl(1,rexxport.sigbit))
  322.   ENDLOOP
  323. ENDPROC
  324.  
  325. PROC checkbreak()
  326. DEF mes:PTR TO intuimessage,iadr,class,code,qual,weiter=FALSE,what
  327.   IF mes:=Gt_GetIMsg(win.userport)
  328.     iadr :=mes.iaddress; class:= mes.class; code:= mes.code; qual:= mes.qualifier
  329.     Gt_ReplyIMsg(mes); what:= getwhat(iadr,class,code,qual)
  330.     SELECT what
  331.       CASE STOPS
  332.         clearinfo();  displayinfo(getstr(STOP_L),0)
  333.         REPEAT
  334.           IF mes:=Gt_GetIMsg(win.userport)
  335.             iadr :=mes.iaddress; class:= mes.class; code:= mes.code; qual:= mes.qualifier
  336.             Gt_ReplyIMsg(mes); what:= getwhat(iadr,class,code,qual)
  337.             IF what=STOPS THEN weiter:= TRUE
  338.             IF what=BREAK
  339.               what:= RemoveGadget(win,bstop)
  340.               bstop.flags:= bstop.flags AND Not(GFLG_SELECTED)
  341.               AddGadget(win,bstop,what); RefreshGList(bstop,win,0,1)
  342.               clearinfo(); displayinfo(getstr(BREAK_L),0); Raise(BREAK); ENDIF
  343.           ELSE; WaitPort(win.userport); ENDIF
  344.         UNTIL weiter; clearinfo()
  345.       CASE BREAK
  346.         clearinfo(); displayinfo(getstr(BREAK_L),0); Raise(BREAK)
  347.     ENDSELECT
  348.   ENDIF
  349. ENDPROC
  350.  
  351. PROC getwhat(iadr,class,code,qual)
  352. DEF inputrec:inputevent,buffer[10]:STRING,x,titel,item,sb,ss
  353.     inputrec.class:= IECLASS_RAWKEY; inputrec.code:= code; inputrec.qualifier:= qual
  354.     IF class=IDCMP_RAWKEY
  355.       IF inputrec.qualifier /*AND IEQUALIFIER_RCOMMAND*/
  356.         MapRawKey(inputrec,buffer,10,0); UpperStr(buffer)
  357.         sb:= IF (x:= InStr(item:= getstr(BREAKBUTTON_L),'_',0))<>-1 THEN item[x+1] AND 223 ELSE -1
  358.         ss:= IF (x:= InStr(item:= getstr(STOPBUTTON_L),'_',0))<>-1  THEN item[x+1] AND 223 ELSE -1
  359.         x:= buffer[]
  360.         SELECT x
  361.           CASE ss; code:= $40; CASE sb; code:= $45
  362.         ENDSELECT
  363.       ENDIF
  364.       SELECT code
  365.         CASE $45
  366.           IF bexit.flags AND GFLG_DISABLED THEN RETURN -1
  367.           x:= RemoveGadget(win,bexit); bexit.flags:= bexit.flags+GFLG_SELECTED
  368.           AddGadget(win,bexit,x); RefreshGList(bexit,win,0,1)
  369.           Delay(4); x:= RemoveGadget(win,bexit)
  370.           bexit.flags:= bexit.flags-GFLG_SELECTED; AddGadget(win,bexit,x)
  371.           RefreshGList(bexit,win,0,1); RETURN BREAK
  372.         CASE $40
  373.           IF bexit.flags AND GFLG_DISABLED THEN RETURN -1
  374.           x:= RemoveGadget(win,bstop); bstop.flags:= Eor(bstop.flags,GFLG_SELECTED);
  375.           AddGadget(win,bstop,x); RefreshGList(bstop,win,0,1); RETURN STOPS
  376.       ENDSELECT
  377.     ELSE; IF iadr=bstop THEN RETURN STOPS; IF iadr=bexit THEN RETURN BREAK; ENDIF
  378.     IF (class=IDCMP_MENUPICK) AND (code<>MENUNULL)
  379.       msgmenucode:= code
  380.       titel:=code AND %11111; item:= Shr(code,5) AND %111111
  381.       SELECT titel
  382.         CASE 0
  383.           SELECT item
  384.             CASE 0; RETURN SAVESTATISTICS
  385.             CASE 2; RETURN ABOUT
  386.             CASE 4; RETURN QUIT
  387.           ENDSELECT
  388.         CASE 1; IF item=9 THEN RETURN STATISTICS ELSE RETURN item+BUBBLE
  389.         CASE 2
  390.           SELECT item
  391.             CASE 0;  RETURN SCREEN
  392.             CASE 1;  RETURN DEGREE
  393.             CASE 2;  RETURN FREEINITVALUE
  394.             CASE 4;  lines    := 0
  395.             CASE 5;  lines    := 1
  396.             CASE 7;  random   := TRUE;  freehand:=             FALSE
  397.             CASE 8;  ascending:= TRUE;  freehand:= random   := FALSE
  398.             CASE 9;  ascending:=        freehand:= random   := FALSE
  399.             CASE 10; freehand := TRUE;  random  := ascending:= FALSE
  400.             CASE 12; complete := Not(complete)
  401.             CASE 14; immediate:= Not(immediate)
  402.           ENDSELECT
  403.       ENDSELECT
  404.     ENDIF
  405. ENDPROC -1
  406.  
  407. PROC start_algorithmus(what)
  408.   clearinfo(); ClearMenuStrip(win); break:= FALSE
  409.   OnGadget(bexit,win,0); OnGadget(bstop,win,0)
  410.   statistics[what-BUBBLE].comps:= 0; statistics[what-BUBBLE].moves:= 0
  411.   statistics[what-BUBBLE].elems:= IF what=HEAP THEN maxlen ELSE maxlen+1
  412.   IF what=HEAP THEN setpoint(0,adr[0],COLCLEAR)
  413.   Eval(funcs[what-BUBBLE]); ResetMenuStrip(win,menus); DisplayBeep(0)
  414.   IF break
  415.     statistics[what-BUBBLE].comps:= 0; statistics[what-BUBBLE].moves:= 0
  416.     statistics[what-BUBBLE].elems:= 0; ENDIF
  417.   OffGadget(bexit,win,0); OffGadget(bstop,win,0)
  418.   IF immediate THEN show_statistics()
  419. ENDPROC
  420.  
  421. PROC complete_array()
  422. DEF x,y,x1,x2,a
  423.   clearinfo(); displayinfo(getstr(ARRAYCOMPLETE_L),0)
  424.   FOR x:= 0 TO maxlen-1
  425.     IF adr[x1:= x]<>freeinitvalue
  426.       FOR y:=x+1 TO maxlen DO IF adr[x2:=y]<>freeinitvalue THEN y:= maxlen+1
  427.       IF adr[x2]=freeinitvalue THEN RETURN
  428.       a:= SpDiv(SpFlt(x2-x1),SpFlt(adr[x2]-adr[x1]))
  429.       FOR y:=x1 TO x2
  430.         setpoint(y,adr[y],0); adr[y]:= adr[x1]+SpFix(SpMul(SpFlt(y-x1),a))
  431.         setpoint(y,adr[y],1)
  432.       ENDFOR
  433.       x:= x2-1
  434.     ENDIF
  435.   ENDFOR
  436. ENDPROC
  437. /*-----------------------------------------------------------------------------*/
  438. PROC bubble(von,bis,adr:PTR TO INT) HANDLE
  439. DEF fertig, pos,loop=1,x
  440.   x:= getstr(BUBBLEW_L)
  441.   REPEAT
  442.     fertig:= TRUE; displayinfo(x,[loop++])
  443.     FOR pos:= von TO bis-1
  444.       checkbreak()
  445.       statistics[BUBBLE-BUBBLE].comps:= statistics[BUBBLE-BUBBLE].comps+1
  446.       IF adr[pos] > adr[pos+1]
  447.         swapentries (adr,pos,pos+1); fertig:=FALSE
  448.         statistics[BUBBLE-BUBBLE].moves:= statistics[BUBBLE-BUBBLE].moves+2
  449.       ENDIF
  450.     ENDFOR
  451.   UNTIL fertig
  452. EXCEPT; break:= TRUE; ENDPROC
  453. /*-----------------------------------------------------------------------------*/
  454. PROC shake (von,bis,adr:PTR TO INT) HANDLE
  455. DEF links, rechts, i, position,loop=1,x
  456.   position:= links:= von; rechts:= bis - 1; /*x:= getstr(SHAKEW_L)*/
  457.   WHILE links <= rechts
  458.     /*displayinfo(x,[links,rechts,loop++])*/
  459.     FOR i := links TO rechts
  460.       checkbreak()
  461.       statistics[SHAKE-BUBBLE].comps:= statistics[SHAKE-BUBBLE].comps+1
  462.       IF adr[i] > adr[i+1]
  463.         swapentries (adr,i,position:=i+1)
  464.         statistics[SHAKE-BUBBLE].moves:= statistics[SHAKE-BUBBLE].moves+2
  465.       ENDIF
  466.     ENDFOR
  467.     rechts := position - 1
  468.     FOR i:= rechts TO links STEP -1
  469.       checkbreak()
  470.       statistics[SHAKE-BUBBLE].comps:= statistics[SHAKE-BUBBLE].comps+1
  471.       IF adr[i] > adr[i+1]
  472.         swapentries (adr,position:=i,i+1)
  473.         statistics[SHAKE-BUBBLE].moves:= statistics[SHAKE-BUBBLE].moves+2
  474.       ENDIF
  475.     ENDFOR
  476.     links := position + 1
  477.   ENDWHILE
  478. EXCEPT; break:= TRUE; ENDPROC
  479. /*-----------------------------------------------------------------------------*/
  480. PROC insert(von,bis,adr:PTR TO INT) HANDLE
  481. DEF j,i
  482.   FOR i:= von+1 TO bis
  483.     FOR j:= i TO von+1 STEP -1
  484.       checkbreak()
  485.       statistics[INSERT-BUBBLE].comps:= statistics[INSERT-BUBBLE].comps+1
  486.       IF adr[j-1] > adr [j]
  487.         swapentries (adr,j-1,j)
  488.         statistics[INSERT-BUBBLE].moves:= statistics[INSERT-BUBBLE].moves+2
  489.       ELSE; j:= von
  490.       ENDIF
  491.     ENDFOR
  492.   ENDFOR
  493. EXCEPT; break:= TRUE; ENDPROC
  494. /*-----------------------------------------------------------------------------*/
  495. PROC selsort(von,bis,adr:PTR TO INT) HANDLE
  496. DEF min,x,y
  497.   min:= von
  498.   FOR x:= von+1 TO bis DO IF adr[x]<adr[min] THEN min:= x
  499.   swapentries(adr,min,von)
  500.   FOR y:= von+1 TO bis-1
  501.     min:=y; checkbreak()
  502.     FOR x:=y+1 TO bis
  503.       IF adr[x] <= adr[min]
  504.         min:= x; statistics[SEL-BUBBLE].comps:= statistics[SEL-BUBBLE].comps+2
  505.         IF adr[min]=adr[y-1] THEN x:= bis
  506.       ENDIF
  507.     ENDFOR
  508.     statistics[SEL-BUBBLE].moves:= statistics[SEL-BUBBLE].moves+2
  509.     swapentries (adr,y,min)
  510.   ENDFOR
  511. EXCEPT; break:= TRUE; ENDPROC
  512. /*-----------------------------------------------------------------------------*/
  513. PROC shell(von,bis,adr:PTR TO INT) HANDLE
  514. DEF i,j,incr,weiter,term= TRUE
  515.   incr:= (bis-von)/3   /* Knut's recommendation */
  516.   WHILE incr
  517.     FOR i:= incr+1 TO bis
  518.       j:= i-incr; weiter:= TRUE
  519.       WHILE (j>=von) AND weiter
  520.         checkbreak()
  521.         statistics[SHELL-BUBBLE].comps:= statistics[SHELL-BUBBLE].comps+1
  522.         IF adr[j] > adr[j+incr]
  523.           statistics[SHELL-BUBBLE].moves:= statistics[SHELL-BUBBLE].moves+2
  524.           swapentries (adr,j,j+incr); j:= j-incr
  525.         ELSE; weiter:= FALSE; ENDIF
  526.       ENDWHILE
  527.     ENDFOR
  528.     IF (incr:= (incr-1)/3)=0  /* ensure that incr becomes at least */
  529.       IF term; term:= FALSE; incr:= 1; ENDIF /* one time 1 */
  530.     ELSE; IF incr=1 THEN term:= FALSE; ENDIF
  531.   ENDWHILE
  532. EXCEPT; break:= TRUE; ENDPROC
  533. /*-----------------------------------------------------------------------------*/
  534. PROC merge (von,bis,adr:PTR TO INT) HANDLE
  535. DEF hilf:PTR TO INT
  536.   hilf:= New(Shl(bis-von+2,1))
  537.   IF hilf; sort1 (adr, von, bis, hilf); Dispose(hilf)
  538.   ELSE;    printerrmsg(getstr(LOWMEM_L),0); ENDIF
  539. EXCEPT; Dispose(hilf); break:= TRUE; ENDPROC
  540.  
  541. PROC mergesort1 (inp:PTR TO INT,von1, bis1,von2,bis2,out:PTR TO INT)
  542. DEF i1, i2, j
  543.   j:= i1 := von1; i2 := von2; checkbreak()
  544.   WHILE (i1 <= bis1) AND (i2 <= bis2)
  545.     checkbreak()
  546.     statistics[MERGE-BUBBLE].comps:= statistics[MERGE-BUBBLE].comps+1
  547.     IF inp[i1] <= inp[i2]
  548.       setpoint(i1,inp[i1],COLCLEAR); setpoint(j,inp[i1],COLSET)
  549.       out[j++] := inp[i1++]
  550.       statistics[MERGE-BUBBLE].moves:= statistics[MERGE-BUBBLE].moves+1
  551.     ELSE
  552.       setpoint(i2,inp[i2],COLCLEAR); setpoint(j,inp[i2],COLSET)
  553.       out[j++] := inp[i2++]
  554.       statistics[MERGE-BUBBLE].moves:= statistics[MERGE-BUBBLE].moves+1
  555.     ENDIF
  556.   ENDWHILE
  557.   WHILE i1 <= bis1
  558.     checkbreak()
  559.     setpoint(i1,inp[i1],COLCLEAR); setpoint(j,inp[i1],COLSET)
  560.     out[j++] := inp[i1++]
  561.     statistics[MERGE-BUBBLE].moves:= statistics[MERGE-BUBBLE].moves+1
  562.   ENDWHILE
  563.   WHILE i2 <= bis2
  564.     checkbreak()
  565.     setpoint(i2,inp[i2],COLCLEAR); setpoint(j,inp[i2],COLSET)
  566.     out[j++] := inp[i2++]
  567.     statistics[MERGE-BUBBLE].moves:= statistics[MERGE-BUBBLE].moves+1
  568.   ENDWHILE
  569. ENDPROC
  570.  
  571. PROC sort1 (unsort_vekt:PTR TO INT,von,bis,hilf:PTR TO INT)
  572. DEF split, x1, x2,i
  573.   IF (bis-von) > 0
  574.     split := Shr((bis-von),1); x1 := von + split; x2 := x1 + 1
  575.     sort2 (unsort_vekt, von, x1, hilf)
  576.     sort2 (unsort_vekt, x2, bis, hilf)
  577.     mergesort1 (unsort_vekt, von, x1, x2, bis, hilf)
  578.     FOR i:= von TO bis
  579.       checkbreak(); unsort_vekt[i]:= hilf[i]
  580.     ENDFOR
  581.     statistics[MERGE-BUBBLE].moves:= statistics[MERGE-BUBBLE].moves+bis-von+1
  582.   ELSE
  583.     hilf[von] := unsort_vekt[von]
  584.     statistics[MERGE-BUBBLE].moves:= statistics[MERGE-BUBBLE].moves+1
  585.   ENDIF
  586. ENDPROC
  587.  
  588. PROC sort2 (unsort_vekt:PTR TO INT,von, bis,hilf:PTR TO INT)
  589. DEF split, x1, x2
  590.   IF (bis-von) > 0
  591.     split := Shr((bis-von),1); x1 := von + split; x2 := x1 + 1
  592.     sort1 (unsort_vekt, von, x1, hilf)
  593.     sort1 (unsort_vekt, x2, bis, hilf)
  594.     mergesort1 (hilf, von, x1, x2, bis, unsort_vekt)
  595.   ENDIF
  596. ENDPROC
  597. /*-----------------------------------------------------------------------------*/
  598. PROC quick(von,bis,adr:PTR TO INT) HANDLE
  599.   qsort(von,bis,adr)
  600. EXCEPT; break:= TRUE; ENDPROC
  601.  
  602. PROC qsort(l, r, a:PTR TO INT)
  603. DEF i, j, x
  604.   i := l; j := r; x := a[Shr((l+r),1)]
  605.   REPEAT
  606.     checkbreak()
  607.     WHILE a[i++] < x DO statistics[QUICK-BUBBLE].comps:= statistics[QUICK-BUBBLE].comps+1
  608.     WHILE x < a[j]
  609.       DEC j; statistics[QUICK-BUBBLE].comps:= statistics[QUICK-BUBBLE].comps+1
  610.     ENDWHILE
  611.     IF i-- <= j
  612.       statistics[QUICK-BUBBLE].moves:= statistics[QUICK-BUBBLE].moves+1
  613.       swapentries(a,i++,j); DEC j
  614.     ENDIF
  615.   UNTIL i > j
  616.   IF l < j THEN qsort(l, j,a)
  617.   IF i < r THEN qsort(i, r,a)
  618. ENDPROC
  619. /*-----------------------------------------------------------------------------*/
  620. PROC heap(von,bis,adr:PTR TO INT) HANDLE
  621. DEF i,x
  622.   x:= Shr(bis,1)
  623.   FOR i:= x TO von STEP -1
  624.     checkbreak(); reheap (i,bis,adr)
  625.   ENDFOR
  626.   FOR i:= bis TO von+1 STEP -1
  627.     checkbreak(); statistics[HEAP-BUBBLE].moves:= statistics[HEAP-BUBBLE].moves+2
  628.     swapentries (adr,von,i); reheap (von,i-1,adr)
  629.   ENDFOR
  630. EXCEPT; break:= TRUE; ENDPROC
  631.  
  632. PROC reheap (i,k,adr:PTR TO INT)
  633. DEF j,son,x
  634.   j:= i
  635.   LOOP
  636.     checkbreak()
  637.     IF (x:=Shl(j,1))  > k THEN RETURN
  638.     IF (x+1)         <= k
  639.       statistics[HEAP-BUBBLE].comps:= statistics[HEAP-BUBBLE].comps+1
  640.       IF adr[x] >= adr[x+1] THEN son:= x ELSE son:= x+1
  641.     ELSE; son:= x; ENDIF
  642.     statistics[HEAP-BUBBLE].comps:= statistics[HEAP-BUBBLE].comps+1
  643.     IF adr[j] <= adr[son]
  644.       swapentries (adr,j,son); j:= son
  645.       statistics[HEAP-BUBBLE].moves:= statistics[HEAP-BUBBLE].moves+2
  646.     ELSE; RETURN; ENDIF
  647.   ENDLOOP
  648. ENDPROC
  649. /*-----------------------------------------------------------------------------*/
  650.  
  651. PROC swapentries(adr:PTR TO INT,i,j)
  652. DEF x
  653.   setpoint(i,adr[i],COLCLEAR); setpoint(j,adr[j],COLCLEAR)
  654.   setpoint(i,adr[j],COLSET);   setpoint(j,adr[i],COLSET)
  655.   x:= adr[i]; adr[i]:= adr[j]; adr[j]:=x
  656. ENDPROC
  657.  
  658. PROC createarray()
  659. DEF x,anstieg,rndadr:PTR TO INT,y,a,b,rndptr,temp
  660.   IF adr THEN Dispose(adr); adr:= New(Shl(maxlen+1,1))
  661.   IF adr
  662.     clearinfo(); displayinfo(getstr(ARRAYCREATE_L),0)
  663.     SetAPen(win.rport,0); RectFill(win.rport,recleft-2,rectop-1,maxlen+3,recheight+rectop+1)
  664.     IF random= FALSE
  665.       anstieg:= SpDiv(SpFlt(maxlen),SpFlt(recheight))
  666.       IF ascending
  667.         FOR x:= 0 TO maxlen
  668.           adr[x]:= SpFix(SpMul(SpFlt(x),anstieg)); setpoint(x,adr[x],1)
  669.         ENDFOR
  670.       ELSE
  671.         FOR x:= 0 TO maxlen
  672.           adr[x]:= SpFix(SpMul(SpFlt(maxlen+1-x),anstieg)); setpoint(x,adr[x],1)
  673.         ENDFOR
  674.       ENDIF
  675.       rndadr:= New(Shl(maxlen+1,1))
  676.       IF rndadr
  677.         y:= SpFix(SpMul(SpDiv(100.0,SpFlt(-maxlen)),SpFlt(degree)))+maxlen
  678.         FOR x:=0 TO maxlen DO rndadr[x]:= 65535
  679.         IF y<>1
  680.           FOR x:=0 TO y
  681.             rndptr:= a:= Rnd(maxlen)+1; b:= Rnd(maxlen)+1
  682.             WHILE (rndadr[rndptr] <> 65535) AND (rndadr[rndptr] = a)
  683.               INC rndptr; IF rndptr > maxlen THEN rndptr:= 0
  684.             ENDWHILE
  685.             rndadr[rndptr]:= a; a:= rndptr; rndptr:= b;
  686.             WHILE (rndadr[rndptr] <> 65535) AND (rndadr[rndptr] = b)
  687.               INC rndptr; IF rndptr > maxlen THEN rndptr:= 0;
  688.             ENDWHILE
  689.             rndadr[rndptr]:= b; b:= rndptr
  690.             setpoint(a,adr[a],COLCLEAR); setpoint(b,adr[b],COLCLEAR)
  691.             temp:= adr[a]; adr[a]:= adr[b]; adr[b]:= temp
  692.             setpoint(a,adr[a],1); setpoint(b,adr[b],1)
  693.           ENDFOR
  694.         ENDIF
  695.         Dispose(rndadr)
  696.       ELSE
  697.         printerrmsg(getstr(LOWMEM_L),0)
  698.         SetAPen(win.rport,0); RectFill(win.rport,recleft,rectop,maxlen,recheight+rectop)
  699.         FOR x:=0 TO maxlen
  700.           adr[x]:= Rnd(recheight+1); setpoint(x,adr[x],1)
  701.         ENDFOR
  702.       ENDIF
  703.     ELSE
  704.       FOR x:=0 TO maxlen
  705.         adr[x]:= Rnd(recheight+1); setpoint(x,adr[x],1)
  706.       ENDFOR
  707.     ENDIF
  708.   ENDIF
  709. ENDPROC
  710.  
  711. PROC clearinfo()
  712.   SetAPen(win.rport,0)
  713.   RectFill(win.rport,2,inforecty,scr.width-3,inforecty+textheight+1)
  714. ENDPROC
  715.  
  716. PROC displayinfo(body,text)
  717. DEF ziel[40]:ARRAY
  718.   SetAPen(win.rport,1)
  719.   RawDoFmt(body,text,{putproc},ziel); TextF(infox,infoy,ziel)
  720. ENDPROC
  721. putproc: MOVE.B D0,(A3)+; RTS
  722.  
  723. PROC setpoint(x,y,c)
  724.   IF lines
  725.     Line(recleft+x,Shr(recheight,1)+rectop+Shr(y,1),
  726.          recleft+x,Shr(recheight,1)+rectop-Shr(y,1),c)
  727.   ELSE; Plot(recleft+x,rectop+recheight-y,c); ENDIF
  728. ENDPROC
  729.  
  730. PROC checkmxmenus(itemnumber,number,which)
  731. DEF x,menu:PTR TO menuitem
  732.   FOR x:= 0 TO number-1
  733.     menu:= ItemAddress(menus,$20*x+itemnumber)
  734.     IF (x+1)=which
  735.       menu.flags:= menu.flags OR CHECKED
  736.     ELSE; menu.flags:= menu.flags AND Not(CHECKED); ENDIF
  737.   ENDFOR
  738. ENDPROC
  739.  
  740. PROC show_statistics()
  741.   IF reqtoolsbase
  742.     RtEZRequestA(getstr(ALGSTATISTIK_L),getstr(OKBUTTON_L),0,statistics,
  743.       [RT_WINDOW,win,RT_LOCKWINDOW,TRUE,RT_REQPOS,REQPOS_CENTERWIN,
  744.        RT_UNDERSCORE,"_",RT_TEXTATTR,['topaz.font',8,0,0]:textattr,0])
  745.   ENDIF
  746. ENDPROC
  747.  
  748. PROC save_statistics(dir,filename) HANDLE
  749. DEF tempdir[300]:ARRAY,filehandle=0,windowlock
  750.   IF reqtoolsbase THEN windowlock:= RtLockWindow(win)
  751.   StrCopy(tempdir,dir,ALL); AddPart(tempdir,filename,300)
  752.   filehandle:=Open(tempdir,MODE_NEWFILE)
  753.   VfPrintf(filehandle,getstr(ALGSTATISTIK_L),statistics)
  754.   Flush(filehandle); Close(filehandle)
  755.   IF reqtoolsbase THEN RtUnlockWindow(win,windowlock)
  756. EXCEPT
  757.   printerrmsg('DOS error: \d',IoErr())
  758.   IF filehandle THEN Close(filehandle)
  759.   IF reqtoolsbase THEN RtUnlockWindow(win,windowlock)
  760. ENDPROC
  761.  
  762. PROC getstr(num)
  763. ENDPROC IF catalog THEN GetCatalogStr(catalog,num,0) ELSE builtinlanguage[num]
  764.  
  765. PROC opengui(modeid,welcome)
  766. DEF x,offy,delta,
  767.     twidth, icht:PTR TO textfont,ichr:PTR TO rastport
  768.     IF modeid=0
  769.       modeid:= IF pscr:= LockPubScreen(0) THEN GetVPModeID(pscr.viewport) ELSE 0
  770.     ENDIF
  771.   scr:=OpenScreenTagList(0,
  772.         [SA_TITLE,      getstr(SCREENTITLE_L),
  773.          SA_PUBNAME,    'VisualSort Screen',
  774.          SA_PENS,       [$ffff]:INT,
  775.          SA_FONT,       IF modeid THEN font:= pscr.font ELSE font:= ['topaz.font',8,0,0]:textattr,
  776.          SA_FULLPALETTE,TRUE,
  777.          SA_DEPTH,      2,
  778.          SA_DISPLAYID,  modeid,
  779.          SA_TYPE,       CUSTOMSCREEN,0])
  780.   PubScreenStatus(scr,0); visual:=GetVisualInfoA(scr,NIL)
  781.   LayoutMenusA(menus:=CreateMenusA([1,0,getstr(PROG_L),0,0,0,0,
  782.                         2,0,(x:= getstr(SAVE_L))+2,IF x[] THEN x ELSE 0,IF filereq THEN 0 ELSE 16,0,0,
  783.                         2,0,-1,0,0,0,0,
  784.                         2,0,(x:=getstr(ABOUT_L))+2,IF x[] THEN x ELSE 0,IF reqtoolsbase THEN 0 ELSE 16,0,0,
  785.                         2,0,-1,0,0,0,0,
  786.                         2,0,(x:=getstr(QUIT_L))+2,IF x[] THEN x ELSE 0,0,0,0,
  787.                         1,0,getstr(ALG_L),0,0,0,0,
  788.                         2,0,(x:=getstr(BUBBLE_L))+2,IF x[] THEN x ELSE 0,0,0,0,
  789.                         2,0,(x:=getstr(SHAKE_L))+2, IF x[] THEN x ELSE 0,0,0,0,
  790.                         2,0,(x:=getstr(INSERT_L))+2,IF x[] THEN x ELSE 0,0,0,0,
  791.                         2,0,(x:=getstr(SELECT_L))+2,IF x[] THEN x ELSE 0,0,0,0,
  792.                         2,0,(x:=getstr(SHELL_L))+2, IF x[] THEN x ELSE 0,0,0,0,
  793.                         2,0,(x:=getstr(MERGE_L))+2, IF x[] THEN x ELSE 0,0,0,0,
  794.                         2,0,(x:=getstr(QUICK_L))+2, IF x[] THEN x ELSE 0,0,0,0,
  795.                         2,0,(x:=getstr(HEAP_L))+2,  IF x[] THEN x ELSE 0,0,0,0,
  796.                         2,0,-1,0,0,0,0,
  797.                         2,0,(x:=getstr(STATISTIK_L))+2,IF x[] THEN x ELSE 0,IF reqtoolsbase THEN 0 ELSE 16,0,0,
  798.                         1,0,getstr(SETUP_L),0,0,0,0,
  799.                         2,0,(x:=getstr(SCR_L))+2,IF x[] THEN x ELSE 0,IF screenmodereq THEN 0 ELSE 16,0,0,
  800.                         2,0,(x:=getstr(DEGREE_L))+2,IF x[] THEN x ELSE 0,IF reqtoolsbase  THEN 0 ELSE 16,0,0,
  801.                         2,0,(x:=getstr(FREEINIT_L))+2,IF x[] THEN x ELSE 0,IF reqtoolsbase THEN 0 ELSE 16,0,0,
  802.                         2,0,-1,0,0,0,0,
  803.                         2,0,(x:=getstr(POINTS_L))+2,IF x[] THEN x ELSE 0,IF lines THEN 1    ELSE $101,32,0,
  804.                         2,0,(x:=getstr(LINES_L))+2, IF x[] THEN x ELSE 0,IF lines THEN $101 ELSE 1   ,16,0,
  805.                         2,0,-1,0,0,0,0,
  806.                         2,0,(x:=getstr(RAND_L))+2,IF x[] THEN x ELSE 0, IF random THEN $101 ELSE 1,256+512+1024,0,
  807.                         2,0,(x:=getstr(ASC_L))+2, IF x[] THEN x ELSE 0, IF random=FALSE   AND ascending THEN $101 ELSE 1,128+1024+512, 0,
  808.                         2,0,(x:=getstr(DES_L))+2, IF x[] THEN x ELSE 0, IF (random=FALSE) AND (ascending=FALSE) AND (freehand=FALSE) THEN $101 ELSE 1,128+256+1024,0,
  809.                         2,0,(x:=getstr(FREEHAND_L))+2,IF x[] THEN x ELSE 0,IF freehand THEN $109 ELSE 9,512+128+256,0,
  810.                         2,0,-1,0,0,0,0,
  811.                         2,0,(x:=getstr(COMPLETE_L))+2,IF x[] THEN x ELSE 0,IF complete THEN $109 ELSE 9,0,0,
  812.                         2,0,-1,0,0,0,0,
  813.                         2,0,(x:=getstr(IMM_L))+2,IF x[] THEN x ELSE 0,IF immediate THEN $109 ELSE 9,0,0,
  814.                         0]:newmenu,NIL),visual,[GTMN_NEWLOOKMENUS,1,0])
  815.  
  816.   twidth:= TextLength(ichr:= scr.rastport,x:=getstr(STOPBUTTON_L),StrLen(x))
  817.   IF (delta:= TextLength(ichr,x:=getstr(BREAKBUTTON_L),StrLen(x)))>twidth THEN twidth:= delta
  818.  
  819.   icht:= ichr.font; textheight:= icht.ysize
  820.   offy:= scr.height-(textheight+6)
  821.   
  822.   bstop:= CreateGadgetA(BUTTON_KIND,CreateContext({glist}),
  823.     [scr.width-twidth,offy,twidth,textheight+6,
  824.      getstr(STOPBUTTON_L),font,0,16,visual,0]:newgadget,
  825.     [GA_DISABLED,TRUE,GT_UNDERSCORE,"_",0])
  826.   bstop.activation:= bstop.activation OR GACT_TOGGLESELECT; delta:= twidth+twidth
  827.   
  828.   bexit:=CreateGadgetA(BUTTON_KIND,bstop,
  829.     [scr.width-delta,offy,twidth,textheight+6,
  830.      getstr(BREAKBUTTON_L),font,1,16,visual,0]:newgadget,
  831.     [GA_DISABLED,TRUE,GT_UNDERSCORE,"_",0])
  832.  
  833.   scroller:=CreateGadgetA(SCROLLER_KIND,bexit,
  834.     [0,offy,scr.width-delta,textheight+6,
  835.      font,NIL,2,0,visual,0]:newgadget,
  836.     [GA_RELVERIFY,1,
  837.      GTSC_TOTAL,128,
  838.      GTSC_VISIBLE,1,
  839.      GA_DISABLED,1,NIL])
  840.  
  841.   win:=OpenWindowTagList(0,
  842.         [WA_FLAGS,       WFLG_ACTIVATE+WFLG_SMART_REFRESH+WFLG_BACKDROP+
  843.                          WFLG_BORDERLESS+WFLG_NEWLOOKMENUS,
  844.          WA_IDCMP,       IDCMP_RAWKEY+IDCMP_GADGETUP+IDCMP_MENUPICK+
  845.                          IDCMP_MOUSEBUTTONS,
  846.          WA_CUSTOMSCREEN,scr,
  847.          WA_GADGETS,     glist,0])
  848.  
  849.   DrawBevelBoxA(stdrast:=win.rport,
  850.     0,inforecty:= offy:=offy-(textheight+6),scr.width,textheight+6,
  851.     [GT_VISUALINFO,visual,NIL]); INC inforecty
  852.  
  853.     infox:= 5
  854.     infoy:= offy+icht.baseline+3
  855.     offy:= offy-scr.barheight-1
  856.  
  857.   DrawBevelBoxA(win.rport,0,x:=scr.barheight+1,scr.width,offy,
  858.     [GT_VISUALINFO,visual,NIL])
  859.  
  860.   displayinfo(welcome,0)
  861.   rectop:= x+2; recleft:=3; recheight:= offy-5; maxlen:= scr.width-8
  862.   IF freeinitvalue>recheight
  863.     freeinitvalue:= 0; printerrmsg(getstr(SETFREETOZERO_L),0); ENDIF
  864.  
  865.   SetMenuStrip(win,menus); Gt_RefreshWindow(win,NIL)
  866. ENDPROC
  867.  
  868. PROC openlibs()
  869.   IF localebase:= OpenLibrary('locale.library',0)
  870.     catalog:= OpenCatalogA(0,'VisualSort.catalog',0)
  871.   ENDIF
  872.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=0
  873.     printerrmsg(getstr(NEEDGADTOOLS_L),0); Raise(SCHLEIF)
  874.   ENDIF
  875.   IF (reqtoolsbase:=OpenLibrary('reqtools.library',38))=0
  876.     printerrmsg(getstr(NEEDREQTOOLS_L),0)
  877.   ELSE
  878.     IF (screenmodereq:=RtAllocRequestA(RT_SCREENMODEREQ,0))=0
  879.       printerrmsg(getstr(ERRSCRMODESTRUCT_L),0)
  880.     ENDIF
  881.     IF (filereq:= RtAllocRequestA(RT_FILEREQ,0))=0
  882.       printerrmsg(getstr(ERRFILEREQSTRUCT_L),0)
  883.     ENDIF; ENDIF
  884.   IF (keymapbase:= OpenLibrary('keymap.library',0))=0
  885.     printerrmsg(getstr(KEYMAP_L),0); Raise(SCHLEIF); ENDIF
  886.   IF FindPort('VISUALSORT'); printerrmsg(getstr(SECONDCOPY_L),0); Raise(SCHLEIF); ENDIF
  887.   IF rexxport:=CreateMsgPort()
  888.     lptr:=rexxport.ln; lptr.name:='VISUALSORT'; lptr.pri:= 0
  889.     AddPort(rexxport)
  890.   ELSE; printerrmsg(getstr(ERRMSGPORT_L),0); ENDIF
  891. ENDPROC
  892.  
  893. PROC initdatas()
  894. DEF x
  895.   FOR x:= 0 TO HEAP-BUBBLE
  896.     statistics[x].moves:= 0; statistics[x].comps:= 0; statistics[x].elems:= 0
  897.   ENDFOR
  898.   rexxkeywords:=[x:= 'dummy',     STRLEN,'QUIT',      STRLEN,'BUBBLESORT',STRLEN,'SHAKESORT', STRLEN,
  899.     'INSERTSORT',STRLEN,'SELECTSORT',STRLEN,'SHELLSORT' ,STRLEN,'MERGESORT', STRLEN,
  900.     'QUICKSORT', STRLEN,'HEAPSORT',  STRLEN,'SCREENMODE',STRLEN, x,5,x,5,
  901.     'POINTS',    STRLEN,'LINES',     STRLEN,'RANDOMIZE', STRLEN,'ASCENDING', STRLEN,
  902.     'DESCENDING',STRLEN,'DEGREE ',   STRLEN,'STATISTICS',STRLEN,'IMMEDIATE ',STRLEN,
  903.     'SAVESTATISTICS ',STRLEN,'FREEHAND',STRLEN,'COMPLETE ',STRLEN,
  904.     'FREEINITVALUE ', STRLEN,'POPUP',     STRLEN,'POPBACK',  STRLEN,
  905.     '',0]:rexxobj
  906.   funcs:= [`bubble(0,maxlen,adr),`shake  (0,maxlen,adr),
  907.            `insert(0,maxlen,adr),`selsort(0,maxlen,adr),
  908.            `shell (0,maxlen,adr),`merge  (0,maxlen,adr),
  909.            `quick (0,maxlen,adr),`heap   (1,maxlen,adr)]
  910.   builtinlanguage:=  ['Project',
  911.                         'W\0Save Statistics...','?\0About...','Q\0Quit',
  912.                       'Algorithms',
  913.                         'B\0BubbleSort','A\0ShakeSort','I\0InsertSort',
  914.                         'C\0SelectSort','L\0ShellSort','M\0MergeSort',
  915.                         'K\0QuickSort','H\0HeapSort','S\0Statistics...',
  916.                       'Setup',
  917.                         '\0\0Screenmode...','O\0Degree...',
  918.                         '*\0Freehand init value...','P\0Points',
  919.                         'N\0Lines','R\0random',
  920.                         '+\0ascending','-\0descending','F\0freehand',
  921.                         'U\0Complete empty parts','Y\0Statistics immediately',
  922.       'Welcome to VisualSort v1.15',
  923.       'creating array...','completing array...',' Brekkies',' *** stopped',
  924.       ' \d[5]th loop  ',' \d[5] left, \d[5] right, \d[5]th loop  ',
  925.       'nice screenmode :-)',
  926.       'draw with left, leave with right mousebutton',
  927.       '\d[5]th element',
  928.       '  Br_eak  ','  St_op  ',
  929.       'choose Filename...','choose Screenmode...',
  930.       'Enter degree...','Enter init value...',
  931.       'VisualSort v1.15 ©1994 by Nico Max',
  932.       '--- VisualSort v1.15 ---\n'+
  933.         '(C) Copyright 1994 by Nico Max\n\n'+
  934.         'Written using..\n\n'+
  935.         'Wouter van Oortmerssen\as Amiga_E v2.1b\n\n'+
  936.         'GUI created using GadToolsBox v2.0b (C) Jaba Development\n'+
  937.         'reqtools.library (C) Copyright by Nico François',
  938.         'This program is Public Domain!. This means that you can\n'+
  939.         'copy it for free but all Copyrights remain to the author!\n\n'+
  940.         'for remarks or if you find bugs (or for sending donatins :-)\n'+
  941.         'please write to:\n\nNico Max\nGerüstbauerring 15\n18109 Rostock\n'+
  942.         'Germany\n\nor email: max@informatik.uni-rostock.de\n\n'+
  943.         'free chip:\d[9], free fast:\d[9]','_More|_Continue',' _Ok ',
  944.    'Algorithm         Moves    Compares Elems\n'+
  945.    '-----------------------------------------\n'+
  946.    'BubbleSort   \d[10]  \d[10] \d[5]\n'+
  947.    'ShakeSort    \d[10]  \d[10] \d[5]\n'+
  948.    'InsertSort   \d[10]  \d[10] \d[5]\n'+
  949.    'SelectSort   \d[10]  \d[10] \d[5]\n'+
  950.    'ShellSort    \d[10]  \d[10] \d[5]\n'+
  951.    'MergeSort    \d[10]  \d[10] \d[5]\n'+
  952.    'QuickSort    \d[10]  \d[10] \d[5]\n'+
  953.    'HeapSort     \d[10]  \d[10] \d[5]\n',
  954.    'Couldn\at \s!',
  955.      'lock publicscreen','open screen','open window',
  956.      'get ModeID','get visualinfo','get context','create gadget',
  957.      'create menus','open file','write',
  958.    'Decide, what you want!\n','0 <= degree <= 100\n',
  959.    'choose: ascending or descending\n','which degree?\n',
  960.    'Out of memory!\nChoose a lower resolution!',
  961.    'DEGREE: must be >= 0 and <= 100','\s: numeric value expected!',
  962.    '\s: Need keyword (ON/OFF)!','\s: Filename needed!',
  963.    'FREEHANDVALUE: must be >= 0 and <= \d!','\s: only ON/OFF!',
  964.    '\s: Unknown command!','Freeinitvalue set to zero!',
  965.    'Need gadtools.library >=v37!','No reqtools.library >=v38 found!\nSeveral menuitems may be unreachable!',
  966.    'Couldn\at allocate Screenmoderequesterstructure','Couldn\at allocate Filerequesterstructure',
  967.    'Need keymap.library!','There\as still another copy of VisualSort active!',
  968.    'Couldn\at allocate Messageport!','Please close all windows!']
  969. ENDPROC
  970.  
  971. PROC closelibs()
  972.   IF catalog       THEN CloseCatalog(catalog)
  973.   IF localebase    THEN CloseLibrary(localebase)
  974.   IF screenmodereq THEN RtFreeRequest(screenmodereq)
  975.   IF filereq;           RtFreeReqBuffer(filereq); RtFreeRequest(filereq); ENDIF
  976.   IF keymapbase    THEN CloseLibrary(keymapbase)
  977.   IF reqtoolsbase  THEN CloseLibrary(reqtoolsbase)
  978.   IF gadtoolsbase  THEN CloseLibrary(gadtoolsbase)
  979.   IF rexxport;          RemPort(rexxport); DeleteMsgPort(rexxport); ENDIF
  980. ENDPROC
  981.  
  982. PROC closegui()
  983.   IF visual; FreeVisualInfo(visual);                visual:= 0; ENDIF
  984.   IF menus;  ClearMenuStrip(win); FreeMenus(menus); menus := 0; ENDIF
  985.   IF win;    CloseWindow(win);                      win   := 0; ENDIF
  986.   IF glist;  FreeGadgets(glist);                    glist := 0; ENDIF
  987.   IF scr;    WHILE CloseScreen(scr)=0 DO printerrmsg(getstr(CLOSESCR),0); scr:= 0; ENDIF
  988.   IF pscr;   UnlockPubScreen(0,pscr);                           ENDIF
  989.   IF adr;    Dispose(adr);                          adr   := 0; ENDIF
  990.   msgmenucode:= MENUNULL
  991. ENDPROC
  992.  
  993. PROC printerrmsg(string,bodyfmt)
  994.   EasyRequestArgs(win,[20,0,0,string,' Ok ']:easystruct,0,bodyfmt)
  995. ENDPROC
  996.  
  997. CHAR '$VER: VisualSort 1.15 (3.30.94)'